home *** CD-ROM | disk | FTP | other *** search
/ Mac Mania 6 / MacMania 6.toast / / Tools&Utilities / TouchMe 1.2□ / touchMe 1.2 Folder / touchMe source codes / CW11 PP source / source / HeaderSampler.pl < prev    next >
Encoding:
Perl Script  |  1997-04-25  |  7.4 KB  |  370 lines  |  [TEXT/McPL]
  1. #!/usr/local/bin/perl
  2.  
  3. # headerSampler.pl, Copyright (C) 1997, Mizutori Tetsuya
  4. # January 7, 1997, February 4, 1997.
  5. # Usage:
  6. # Drag and drop the C++ header files onto this 'header.pl' script
  7.  
  8. use integer;
  9. #use strict ('subs','vars');
  10.  
  11. my $gMAC = ( $ENV{'HOME'} =~ /^$/ );
  12. #if ( $gMAC ) { print "I love Macintosh.\n"; }
  13. my $gScope = "";
  14. my $gSentence = "";
  15.  
  16. # if the command line includes no file list, then prompt the choose dialog.
  17. push(@ARGV, ChooseFile()) unless defined @ARGV;
  18.  
  19. DoMain();
  20.  
  21. ExitToShell();
  22.  
  23. #
  24.  
  25. ################
  26. # DoMain
  27. ################
  28.  
  29. sub DoMain {
  30.     my $filepath;
  31.     my $countFiles = 0;
  32.  
  33.     foreach $filepath (@ARGV) {
  34.         my ($creator,$type) = GetFileInfo($filepath);
  35.  
  36.         $countFiles++;
  37.         print "[$countFiles] = ['$creator','$type'] $filepath\n";
  38.  
  39. #        skip if the file is not 'TEXT' nor '*.h'.
  40.         next if ($type ne 'TEXT');
  41.         next unless ($filepath =~ /\.h$/);
  42.  
  43.         $gScope = "private:";
  44.         $gSentence = "";
  45.         @gComment = ();
  46.         $gIsIgnoring = 0;
  47.  
  48.         open(IN, $filepath) || die "Can't open '$filepath'";
  49.         print '-' x 32; print "\n";
  50.         while (<IN>) {
  51.         chomp;
  52.         HandleTextline();
  53.         }
  54.         print '-' x 32; print "\n";
  55.         close IN;
  56.     }
  57. }
  58.  
  59.  
  60. ################
  61. # HandleTextline
  62. ################
  63.  
  64. sub HandleTextline {
  65.  
  66. # fetch the commant part if it exists.
  67.     if ( m/\/\/.*$/ ) { $gComment[$#gComment + 1] = $&; }
  68.  
  69. # ignore the comment part in the line.
  70.     s/^(.*)\/\/.*$/$1/;
  71.  
  72. # trim the line.
  73.     s/^[ \t]+//;
  74.     s/[ \t]+$//;
  75.  
  76.     SWITCH: {
  77.  
  78.         # skip 'typedef' or 'struct' region.
  79.         (/^typedef/ || /^struct/) && do {
  80.             $gIsIgnoring = 1;
  81.             last SWITCH;
  82.             };
  83.  
  84.         # skip this line if it begins with "#ifdef", "#endif", and others.
  85.         /^#/ && do {
  86.             @gComment = ();
  87.             last SWITCH;
  88.             };
  89.  
  90.         # ignore this line if it begins with "public" and other keywords.
  91.         (/^public:/ || /^protected:/ || /^private:/) && do {
  92.             $gScope = $_;
  93.             $gSentence = "";
  94.             @gComment = ();
  95.             last SWITCH;
  96.         };
  97.  
  98.         # skip this line if it ends with "}???;".
  99.         /\}.*;$/ && do {
  100.             $gSentence = "";
  101.             @gComment = ();
  102.             $gIsIgnoring = 0;
  103.             last SWITCH;
  104.             };
  105.  
  106.         # test if end of 'typedef' or 'struct' region.
  107.             ($gIsIgnoring) && do {
  108.             last SWITCH;
  109.             };
  110.  
  111.         # append this line to my sentence.
  112.         do {
  113.             $gSentence .= "\t" unless $gSentence =~ /^$/;
  114.             $gSentence .= $_;
  115.         };
  116.  
  117.         # handle my sentence if the line ends with ";".
  118.         /;$/ && do {
  119.             $_ = $gSentence;
  120.             ApplySentence();
  121.             $gSentence = "";
  122.             @gComment = ();
  123.             last SWITCH;
  124.             };
  125.     }
  126. }
  127.  
  128.  
  129. ################
  130. # ApplySentence
  131. ################
  132.  
  133. sub ApplySentence {
  134. #    my ($textline) = @_;
  135.  
  136. # eliminate the duplicate spaces to a blank space.
  137.     s/[ \t]+/ /g;
  138.  
  139. # eliminate the ";" character at the tail end.
  140.     s/[ ]*;$//;
  141.  
  142.     if ( s/[ ]*const$// ) { PrintFunction(); }        # if the function has 'const'modifier.
  143.     elsif ( /\)$/ ) { PrintFunction(); }
  144.     else { PrintVariable(); }
  145.  
  146. }
  147.  
  148.  
  149. ################
  150. # PrintFunction
  151. ################
  152.  
  153. sub PrintFunction {
  154. # print a comment.
  155.     my $textline;
  156.     if ( $#gComment >= 0 ) {
  157.         foreach $textline (@gComment) {
  158.             print "\t\t$textline\n";
  159.         }
  160.     }
  161.  
  162. # print a scope sign.
  163.     print WhichScope();
  164.  
  165. #    print "#$_\n";
  166.     my $functype, $funcname, $funcargs;
  167.  
  168. # split line to <NAME{$`}> ( <ARGS{$1}> ) parts.
  169.     m/[ ]*\([ ]*(.*)[ ]*\)[ ]*/;
  170.     $funcname = $`;
  171.     $funcargs = $1;
  172.     $funcname =~ s/[ ]+$//;
  173.     $funcargs =~ s/[ ]+$//;
  174.  
  175. # handle func name.
  176.     split(/[ ]+/,$funcname);
  177.     $funcname = pop();
  178.     $functype = join(' ', @_);
  179.  
  180. # handle func arg list.
  181.     split(/[ ]*,[ ]*/, $funcargs);
  182.     my @args = @_;
  183.         for (@args) {
  184.             if ( /[ ]*=[ ]*/ ) { $_ = $`; }        # for default value; ex. (short X = 100)
  185.             split(/[ ]+/);
  186.             pop();
  187.             $_ = join(' ',@_);
  188.         }
  189.     $funcargs = join(', ', @args);
  190.  
  191. #    print "FUNC = TYPE($funcname)+NAME($funcname)+ARGS($funcargs)\n";
  192.         print $funcname . "\t" x CalcTabs($funcname,5) . $functype . "(" . $funcargs . ")";
  193.         print "\n";
  194. }
  195.  
  196.  
  197. ################
  198. # PrintVariable
  199. ################
  200.  
  201. sub PrintVariable {
  202.  
  203. # print a scope sign.
  204.     print WhichScope();
  205.  
  206. #    print "#$_\n";
  207.     my $vartype;
  208.     my $varname = $_;
  209.     my $varargs = "";
  210.  
  211. # split line to <NAME{$`}> [ <ARGS{$1}> ] parts.
  212.     if ( m/[ ]*\[[ ]*(.*)[ ]*\][ ]*/ ) {
  213.         $varname = $`;
  214.         $varargs = $1;
  215.         $varname =~ s/[ ]+$//;
  216.         $varargs =~ s/[ ]+$//;
  217.     }
  218.  
  219.     split(/[ ]+/,$varname);
  220.     my $vartype = join(' ', @_[0..($#_ - 1)]);
  221.     my $varname = $_[$#_];
  222.  
  223. #    print variable definition
  224.     print $vartype . "\t"  x CalcTabs($vartype,5). $varname;
  225.     if ( $varargs ne "" ) { print "[" . $varargs . "]"; }
  226.  
  227. # print a comment.
  228.     if ( $#gComment >= 0 ) {
  229.         print "\t"  x CalcTabs($varname,4);
  230.         print join("\t",@gComment);
  231.     }
  232.  
  233.     print "\n";
  234. }
  235.  
  236.  
  237. ################
  238. # WhichScope()
  239. ################
  240.  
  241. sub WhichScope {
  242. #    my ($textline) = @_;
  243.     my $key;
  244.     my $str;
  245.  
  246.     SWITCH: {
  247.         ( s/^virtual[ ]*// ) && do { $key = "v"; last SWITCH; };
  248.         ( s/^static[ ]*// ) && do { $key = "s"; last SWITCH; };
  249.         do { $key = "."; last SWITCH; }
  250.     };
  251.  
  252.     SWITCH: {
  253.         ($gScope =~ /^public/ ) && do { $str = "=" . $key . "="; last SWITCH; };
  254.         ($gScope =~ /^protected/ ) && do { $str = ">" . $key . ">"; last SWITCH; };
  255.         ($gScope =~ /^private/ ) && do { $str = "(" . $key . ")"; last SWITCH; };
  256.         do { $str = " " . $key . " "; last SWITCH; };
  257.     };
  258.  
  259.     return $str . "\t";
  260. }
  261.  
  262.  
  263. ################
  264. # StringWidth
  265. ################
  266.  
  267. sub StringWidth {
  268.     my ($str) = @_;
  269.  
  270. # width table of 10-point Geneva font
  271.     my %width_table = (
  272.     ' '=> 3, '!'=> 4, '"'=> 5, '#'=> 9, '\$'=> 7, '%'=>10, '&'=> 8, '\''=> 3, 
  273.     '('=> 6, ')'=> 6, '*'=> 7, '+'=> 8, ','=> 4, '-'=> 7, '.'=> 3, '/'=> 6, 
  274.     '0'=> 7, '1'=> 7, '2'=> 7, '3'=> 7, '4'=> 7, '5'=> 7, '6'=> 7, '7'=> 7, 
  275.     '8'=> 7, '9'=> 7, ':'=> 3, ';'=> 4, '<'=> 5, '='=> 7, '>'=> 5, '?'=> 7, 
  276.     '@'=> 9, 'A'=> 6, 'B'=> 7, 'C'=> 6, 'D'=> 7, 'E'=> 6, 'F'=> 6, 'G'=> 6, 
  277.     'H'=> 7, 'I'=> 4, 'J'=> 6, 'K'=> 7, 'L'=> 6, 'M'=> 9, 'N'=> 7, 'O'=> 6, 
  278.     'P'=> 7, 'Q'=> 6, 'R'=> 7, 'S'=> 6, 'T'=> 6, 'U'=> 7, 'V'=> 6, 'W'=>10, 
  279.     'X'=> 6, 'Y'=> 6, 'Z'=> 6, '['=> 5, '\\'=> 5, ']'=> 5, '^'=> 5, '_'=> 7, 
  280.     '`'=> 4, 'a'=> 5, 'b'=> 6, 'c'=> 5, 'd'=> 5, 'e'=> 5, 'f'=> 4, 'g'=> 5, 
  281.     'h'=> 6, 'i'=> 4, 'j'=> 5, 'k'=> 6, 'l'=> 4, 'm'=> 9, 'n'=> 6, 'o'=> 5, 
  282.     'p'=> 6, 'q'=> 5, 'r'=> 6, 's'=> 5, 't'=> 4, 'u'=> 6, 'v'=> 6, 'w'=> 8, 
  283.     'x'=> 6, 'y'=> 6, 'z'=> 5, '{'=> 5, '|'=> 4, '}'=> 5, '~'=> 7
  284. );
  285.  
  286. #    my $tab_width = 4 * $width_table{'0'};
  287.  
  288.     my $sum = 0;
  289.     my $c;
  290.  
  291.     foreach $c ( split(//,$str) ) {
  292.         $sum += $width_table{$c};
  293. #    print "'$c' =>$width_table{$c}/$sum\n";
  294.     }
  295.  
  296.     return $sum;
  297. }
  298.  
  299.  
  300. ################
  301. # CalcTabs
  302. ################
  303.  
  304. sub CalcTabs {
  305.     my ($str,$tabn) = @_;
  306.     my $tab_width = 4 * StringWidth('0');
  307.     my $tab_position = $tabn * $tab_width;
  308.     my $skip_dots = $tab_position - StringWidth($str);
  309.     my $more_tabs = 1;
  310.  
  311.     if ( $skip_dots > 0 ) {
  312.         $more_tabs += ($skip_dots - 1) / $tab_width;
  313.     }
  314.  
  315. #    print "["; print "$more_tabs:$skip_dots"; print "]";
  316.  
  317.     return $more_tabs;
  318. }
  319.  
  320.  
  321. ################
  322. # ExitToShell()
  323. ################
  324. # Macintosh specific routine
  325.  
  326. sub ExitToShell {
  327.  
  328. # if the runtime environment is a Macintosh.
  329.     &MacPerl'Quit(1) if $gMAC;
  330.  
  331. # else then it is a Unix.
  332.     exit(0);
  333. }
  334.  
  335.  
  336. ################
  337. # GetFileInfo()
  338. ################
  339. # Macintosh specific routine
  340. # Returns a list ($creator,$type)
  341.  
  342. sub GetFileInfo {
  343.     my ($filepath) = @_;
  344.  
  345. # if the runtime environment is a Macintosh.
  346.     return &MacPerl'GetFileInfo($filepath) if $gMAC;
  347.  
  348. # else then it is a Unix and if the file is a text file.
  349.     return ('????', 'TEXT') if -T $filepath;
  350.  
  351. # otherwise returns nil.
  352.     return ('????', '????');
  353. }
  354.  
  355.  
  356. ################
  357. # ChooseFile()
  358. ################
  359. # Macintosh specific routine
  360. # Returns a file path $filepath
  361.  
  362. sub ChooseFile {
  363.     require "GUSI.ph";
  364.  
  365.     return &MacPerl'Choose(&GUSI'AF_FILE, 0, "Select C++ header files",
  366.         &GUSI'pack_sa_constr_file("TEXT"));
  367. }
  368.  
  369. ### end of script ###
  370.